home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tptc17sc.zip / TPCEXPR.INC < prev    next >
Text File  |  1988-03-26  |  18KB  |  760 lines
  1.  
  2. (*
  3.  * TPTC - Turbo Pascal to C translator
  4.  *
  5.  * (C) 1988 Samuel H. Smith (rev. 13-Feb-88)
  6.  *
  7.  *)
  8.  
  9.  
  10. (*
  11.  * expression parser
  12.  *
  13.  *)
  14. function pterm: string; forward;
  15.  
  16. function iscall(var lv: string): boolean;
  17.    {see if the given lvalue is a function call or not}
  18. begin
  19.    iscall := lv[length(lv)] = ')';
  20. end;
  21.  
  22.  
  23. procedure make_pointer(var expr: string);
  24.    {convert the expression into a pointer constant, if possible}
  25. var
  26.    sym:  symptr;
  27. begin
  28.    
  29.    case(expr[1]) of
  30.       '*':
  31.       begin
  32.          delete(expr,1,1);
  33.          exit;
  34.       end;
  35.       
  36.       'a'..'z','A'..'Z','_':
  37.       begin         {pass pointer to strings/arrays}
  38.          sym := locatesym(expr);
  39.          if (sym <> nil) and ((sym^.symtype = s_string) or
  40.                               (sym^.suptype = ss_array)) then
  41.          begin
  42.             {null}
  43.          end
  44.          else
  45.          
  46.          if expr[length(expr)-1] = '(' then    {remove () from function calls}
  47.             dec(expr[0],2)
  48.             
  49.          else
  50.             expr := '&' + expr;
  51.       end;
  52.       
  53.    end;
  54.  
  55. end;
  56.  
  57.  
  58. function isnumber(var lv: string): boolean;
  59.   {see if the given value is a literal number}
  60. var
  61.    i: integer;
  62. begin
  63.    for i := 1 to length(lv) do
  64.       case lv[i] of
  65.          '0'..'9','.': ;
  66.          else
  67.             isnumber := false;
  68.             exit;
  69.       end;
  70.    isnumber := true;
  71. end;
  72.  
  73.  
  74. procedure subtract_base(var expr: string; base: integer);
  75.    {subtract the specified base from the given expression;
  76.     use constant folding if possible}
  77. begin
  78.    if base <> 0 then
  79.       if isnumber(expr) then
  80.          expr := itoa(atoi(expr) - base)
  81.       else
  82.       if base > 0 then
  83.          expr := expr + '-' + itoa(base)
  84.       else
  85.          expr := expr + '+' + itoa(-base);
  86. end;
  87.  
  88.  
  89. function exprtype: char;
  90.    {determine expression type and return the printf code for the type}
  91. var
  92.    xt:      char;
  93.  
  94. begin
  95.    case cexprtype of
  96.       s_char:    xt := 'c';
  97.       s_file:    xt := '@';
  98.       s_double:  xt := 'f';
  99.       s_string:  xt := 's';
  100.       s_bool:    xt := 'b';
  101.       s_int:     xt := 'd';
  102.       s_long:    xt := 'D'; { calling routine should convert to "ld" }
  103.       else       xt := '?';
  104.    end;
  105.  
  106.    exprtype := xt;
  107. end;
  108.  
  109.  
  110. function strtype(ty: char): boolean;
  111.    {see if the expression is a string data type or not}
  112. begin
  113.    case ty of
  114.       's','c':  strtype := true;
  115.       else      strtype := false;
  116.    end;
  117. end;
  118.  
  119.  
  120.  
  121. function psetof:  string;
  122.    {parse a literal set; returns the set literal translated into
  123.     the form: setof(.....)}
  124. var
  125.    ex: string;
  126.  
  127. begin
  128.    ex := 'setof(';
  129.    if tok[1] <> ']' then
  130.       ex := ex + pterm;
  131.  
  132.    while (tok = '..') or (tok[1] = ',') do
  133.    begin
  134.       if tok = '..' then       
  135.          ex := ex + ',__,'
  136.       else
  137.          ex := ex + ',';
  138.  
  139.       gettok;
  140.       ex := ex + pterm;
  141.    end;
  142.  
  143.    if ex[length(ex)] <> '(' then
  144.       ex := ex + ',';
  145.    ex := ex + '_E)';
  146.    psetof := ex;
  147. end;
  148.  
  149.  
  150. function pterm:   string;
  151.    {parse an expression term;  returns the translated expression term;
  152.     detects subexpressions, set literals and lvalues(variable names)}
  153. var
  154.    ex: string;
  155.    builtin: boolean;
  156.  
  157. begin
  158.    if debug_parse then write(' <term>');
  159.  
  160.    if (toktype = identifier) and (cursym <> nil) then
  161.       builtin := cursym^.suptype = ss_builtin
  162.    else
  163.       builtin := false;
  164.  
  165.    (* process pos(c,str) and pos(str,str) *)
  166.    if builtin and (tok = 'POS') then
  167.    begin
  168.       if debug_parse then write(' <pos>');
  169.       gettok;   {consume the keyword}
  170.       if tok[1] <> '(' then
  171.          syntax('"(" expected (pterm.pos)');
  172.       
  173.       gettok;   {consume the (}
  174.       ex := pexpr;
  175.       if exprtype{(ex)} = 'c' then
  176.          ex := 'cpos(' + ex
  177.       else
  178.          ex := 'spos(' + ex;
  179.  
  180.       gettok;   {consume the ,}
  181.       ex := ex + ',' + pexpr;
  182.       gettok;   {consume the )}
  183.       pterm := ex + ')';
  184.       cexprtype := s_int;
  185.    end
  186.    else
  187.  
  188.    (* process chr(n) *)
  189.    if builtin and (tok = 'CHR') then
  190.    begin
  191.       if debug_parse then write(' <chr>');
  192.       gettok;   {consume the keyword}
  193.       if tok[1] <> '(' then
  194.          syntax('"(" expected (pterm.chr)');
  195.       
  196.       gettok;   {consume the (}
  197.       ex := pexpr;
  198.       gettok;   {consume the )}
  199.  
  200.       if isnumber(ex) then
  201.          ex := numlit(atoi(ex))
  202.       else
  203.          ex := 'chr('+ex+')';
  204.  
  205.       pterm := ex;
  206.       cexprtype := s_char;
  207.    end
  208.    else
  209.  
  210.    (* translate NOT term into !term *)
  211.    if builtin and (tok = 'NOT') then
  212.    begin
  213.       if debug_parse then write(' <not>');
  214.       gettok;
  215.       pterm := '!' + pterm;
  216.       cexprtype := s_bool;
  217.    end
  218.    else
  219.  
  220.    (* process port/memory array references *)
  221.    if builtin and ((tok = 'PORT') or (tok = 'PORTW') or
  222.                    (tok = 'MEM')  or (tok = 'MEMW')) then
  223.    begin
  224.       if debug_parse then write(' <port>');
  225.       if tok = 'PORT'  then ex := 'inportb('    else
  226.       if tok = 'PORTW' then ex := 'inport('     else
  227.       if tok = 'MEM'   then ex := 'peekb('      else
  228.                             ex := 'peek(';
  229.  
  230.       gettok;     {consume the keyword}
  231.       gettok;     {consume the [ }
  232.  
  233.       repeat
  234.          ex := ex + pexpr;
  235.          if tok[1] = ':' then
  236.          begin
  237.             gettok;
  238.             ex := ex + ',';
  239.          end;
  240.       until (tok[1] = ']') or recovery;
  241.  
  242.       gettok;     {consume the ] }
  243.       pterm := ex + ')';
  244.       cexprtype := s_int;
  245.    end
  246.    else
  247.  
  248.    (* translate bitwise not (mt+) *)
  249.    if (tok[1] = '?') or (tok[1] = '~') or (tok[1] = '\') then
  250.    begin
  251.       if debug_parse then write(' <bitnot>');
  252.       gettok;
  253.       pterm := '!' + pterm;         {what is a bitwise NOT in c?}
  254.    end
  255.    else
  256.  
  257.    (* process unary minus *)
  258.    if tok = '-' then
  259.    begin
  260.       if debug_parse then write(' <unary>');
  261.       gettok;
  262.       pterm := '-' + pterm;
  263.    end
  264.    else
  265.  
  266.    (* translate address-of operator *)
  267.    if tok[1] = '@' then
  268.    begin
  269.       if debug_parse then write(' <ref>');
  270.       gettok;  {consume the '@'}
  271.       ex := plvalue;
  272.       make_pointer(ex);
  273.       pterm := ex;
  274.    end
  275.    else
  276.  
  277.    (* pass numbers *)
  278.    if toktype = number then
  279.    begin
  280.       if debug_parse then write(' <number>');
  281.       pterm := tok;
  282.       gettok;
  283.       cexprtype := s_int;
  284.    end
  285.    else
  286.  
  287.    (* pass strings *)
  288.    if toktype = strng then
  289.    begin
  290.       if debug_parse then write(' <string>');
  291.       pterm := tok;
  292.       gettok;
  293.       cexprtype := s_string;
  294.    end
  295.    else
  296.  
  297.    (* pass characters *)
  298.    if toktype = chars then
  299.    begin
  300.       if debug_parse then write(' <char>');
  301.       pterm := tok;
  302.       gettok;
  303.       cexprtype := s_char;
  304.    end
  305.    else
  306.  
  307.    (* pass sub expressions *)
  308.    if tok[1] = '(' then
  309.    begin
  310.       if debug_parse then write(' <subexp>');
  311.       gettok;
  312.       pterm := '(' + pexpr + ')';
  313.       gettok;
  314.    end
  315.    else
  316.  
  317.    (* translate literal sets *)
  318.    if tok[1] = '[' then
  319.    begin
  320.       if debug_parse then write(' <setlit>');
  321.       gettok;
  322.       pterm := psetof;
  323.       gettok;
  324.       cexprtype := s_struct;
  325.    end
  326.  
  327.    (* otherwise the term will be treated as an lvalue *)
  328.    else
  329.       pterm := plvalue;
  330. end;
  331.  
  332.  
  333. function pexpr: string;
  334.    {top level expression parser; parse and translate an expression and
  335.     return the translated expr}
  336. var
  337.    ex:       string;
  338.    ty:       char;
  339.    ex2:      string;
  340.    ty2:      char;
  341.  
  342.    procedure relop(newop: string40);
  343.    begin
  344.       if debug_parse then write(' <relop>');
  345.       gettok;        {consume the operator token}
  346.  
  347.       ex2 := pterm;  {get the second term}
  348.       ty2 := exprtype;
  349.  
  350.       {use strcmp if either param is a string}
  351.       if ty = 's' then
  352.       begin
  353.          if ty2 = 's' then
  354.             ex := 'strcmp(' + ex + ',' + ex2 + ') ' + newop + ' 0'
  355.          else
  356.          if ex2[1] = '''' then
  357.             ex := 'strcmp(' + ex + ',"' +
  358.                      copy(ex2,2,length(ex2)-2) + '") ' + newop + ' 0'
  359.          else
  360.             ex := 'strcmp(' + ex + ',ctos(' + ex2 + ')) ' + newop + ' 0'
  361.